home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / depthchg.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-04-24  |  9.1 KB  |  206 lines
  1. 10  'depth charge - j.m. kotler  1982
  2. 11  'requires BASICA
  3. 15  'release 1.1: Improved hit detection. Added bonus for hitting conning tower.
  4. 20  'release 1.2: Added vertical mvmt. Fixed 'illegal function' bug. 25.28/P
  5. 25  WIDTH 80
  6. 30  LOCATE 1,1,0'ensure cursor is off if run as parm
  7. 40  KEY OFF
  8. 50  DEFINT A-Z
  9. 60  DY = 1
  10. 70  YMAX=25' max depth of subs and depthcharges - can be set lower for easy game
  11. 80  SMINY=4 'min depth of subs - can be set higher for harder game
  12. 90  DIM MINSCORE(25) 'MIN SCORE FOR EACH PASS - INIT TO MINIMAL SCORE NEEDED TO GET ANOTHER BONUS PASS - FIRST 3 ARE 0
  13. 100  BONUSP=5' first bonus pass #
  14. 110  MINSCORE (BONUSP)=50*(BONUSP-1)
  15. 120  FOR P=BONUSP+1 TO 25:MINSCORE(P)=MINSCORE(P-1)+10*P:NEXT
  16. 130  B$=" " ' background
  17. 140  D$="THENSTEPTHEN<UNK! {00F7}><UNK! {00F7}>":DB$="     " 'destroyer and erase
  18. 150  C$="<UNK! {00F8}>":C2$="/" 'depthcharge - alternating characters
  19. 160  S$="SOUNDSOUNDSOUNDUSRSOUNDSOUND":SB$="      " 'sub and erase
  20. 170  AS1=ASC("SOUND"):AS2=ASC("USR")
  21. 180  SXMAX = 80-(LEN(S$)+1)
  22. 190  DIM BM$(11,4)
  23. 200  BM$(0,0)="     ":BM$(1,0)="     ":BM$(2,0)="  LINE  ":BM$(3,0)=" LINE<UNK! {FEB0}> "
  24. 210  BM$(0,1)="     ":BM$(1,1)="     ":BM$(2,1)=" LINE<UNK! {FEB0}> ":BM$(3,1)="WHILECSRLINWENDCSRLINWHILE"
  25. 220  BM$(0,2)="     ":BM$(1,2)="     ":BM$(2,2)=" WENDLINEWENDWHILE":BM$(3,2)="LINEWHILEWENDWHILELINE"
  26. 230  BM$(0,3)="     ":BM$(1,3)=" LINEWHILELINE ":BM$(2,3)="WHILE<UNK! {FEB1}>WENDWHILE":BM$(3,3)="boom!"
  27. 240  BM$(0,4)="LINEWHILE  LINE":BM$(1,4)="BOOM!":BM$(2,4)="WENDLINE LINEWEND":BM$(3,4)="<UNK! {FE20}>  <UNK! {FE22}>
  28. 250  '
  29. 260  BM$(4,0)="LINE  POINT ":BM$(5,0)="  <UNK! {FE20}> ":BM$(6,0)="  <UNK! {FE20}> ":BM$(7,0)="     "
  30. 270  BM$(4,1)=" WENDCSRLIN LINE":BM$(5,1)=" <UNK! {FE20}>WEND ":BM$(6,1)=" LINE <UNK! {FE20}>":BM$(7,1)="     "
  31. 280  BM$(4,2)="INKEY$LINE CSRLINWHILE":BM$(5,2)="LINELINE  LINE":BM$(6,2)=" <UNK! {FE20}>  ":BM$(7,2)="     "
  32. 290  BM$(4,3)="BOOM!":BM$(5,3)="B00M!":BM$(6,3)="WHILEooM<UNK! {FE22}>:BM$(7,3)="     "
  33. 300  BM$(4,4)=" <0xDF!>  POINT":BM$(5,4)="LINE    ":BM$(6,4)="   <UNK! {FE20}>":BM$(7,4)="     "
  34. 310  '
  35. 320  BM$(8,0)="  B  ":BM$(9,0)=" <UNK! {00F8}>B<UNK! {00F9}> ":BM$(10,0)="  B<UNK! {00F9}> ":BM$(11,0)=" <UNK! {00FA}>B  "
  36. 330  BM$(8,1)=" <UNK! {00F9}>O<UNK! {00F8}><UNK! {00FA}>":BM$(9,1)=" <UNK! {00F9}>Oo ":BM$(10,1)="<UNK! {00F8}> O <UNK! {00F9}>":BM$(11,1)=" <UNK! {00F8}>O<UNK! {00FA}> "
  37. 340  BM$(8,2)="<UNK! {00F8}> N<UNK! {00FA}> ":BM$(9,2)=" <UNK! {00F8}>N<UNK! {00F9}><UNK! {00F8}>":BM$(10,2)="<UNK! {00FA}> N o":BM$(11,2)="<UNK! {00FA}> N<UNK! {00F8}> "
  38. 350  BM$(8,3)=" <UNK! {00F9}>U o":BM$(9,3)="o U<UNK! {00F8}> ":BM$(10,3)=".<UNK! {00FA}>U<UNK! {00F9}> ":BM$(11,3)=" <UNK! {00F8}>U<UNK! {00FA}> "
  39. 360  BM$(8,4)="--S--":BM$(9,4)="<UNK! {00F9}>-S-<UNK! {00F9}>":BM$(10,4)=" -S-<UNK! {00F8}>":BM$(11,4)=" .S<UNK! {00F9}> "
  40. 361  '
  41. 362  BT$(0,0)=" ":BT$(1,0)=" ":BT$(2,0)=" ":BT$(3,0)=" ":BT$(4,0)="USR"
  42. 363  BT$(0,1)=" ":BT$(1,1)=" ":BT$(2,1)=" ":BT$(3,1)="PSET":BT$(4,1)="<UNK! {00FA}>"
  43. 364  BT$(0,2)=" ":BT$(1,2)=" ":BT$(2,2)="SPC(":BT$(3,2)="<UNK! {00FA}>":BT$(4,2)="<UNK! {00F9}>"
  44. 365  BT$(0,3)=" ":BT$(1,3)="<0xB5!>":BT$(2,3)="<UNK! {00FA}>":BT$(3,3)="<UNK! {00F9}>":BT$(4,3)=" "
  45. 366  BT$(0,4)="USR":BT$(1,4)="<UNK! {00FA}>":BT$(2,4)="<UNK! {00F9}>":BT$(3,4)=" ":BT$(4,4)=" "
  46. 370  GOSUB 980 'instructions
  47. 380  RANDOMIZE  VAL(RIGHT$(TIME$,2))
  48. 390  AGAIN$="Y"
  49. 400  WHILE AGAIN$<>"n" AND AGAIN$<>"N"
  50. 410  'START NEW GAME
  51. 420  COLOR 7:CLS
  52. 430  COLOR 1:LOCATE DY:FOR X=1 TO 80:PRINT B$;:NEXT:COLOR 7
  53. 440  FOR C=0 TO 4: X(C)=C:Y(C)=1:NEXT
  54. 450  FOR S=1 TO 4: SX(S)=1+RND*SXMAX:SY(S)=SMINY+RND*(YMAX-SMINY):NEXT
  55. 460  KEY (14) ON
  56. 470  LOCATE DY+1
  57. 480  IF B$ <> " " THEN FOR Y=1 TO (YMAX-DY-1)*80-1:PRINT B$;:NEXT
  58. 490  FC=4
  59. 500  SCORE=0:P=1:RVY=80*(BONUSP-1)+1
  60. 510  ON KEY(14) GOSUB 940
  61. 520   WHILE SCORE >= MINSCORE(P) AND P<25
  62. 530  DX=80-LEN(DB$)
  63. 540  DX=80-LEN(D$)+1
  64. 550  WHILE DX
  65. 560  COLOR 6,1,0:LOCATE 1,1:IF SCORE < MINSCORE (P+1) THEN PRINT "["; ELSE PRINT " ";
  66. 570  LOCATE ,70:PRINT P;SCORE;:LOCATE DY,DX:PRINT D$;:COLOR 7
  67. 580  ALT = NOT ALT
  68. 590  FOR C=1 TO 4
  69. 600  Y=Y(C):IF Y >1 THEN X=X(C):SCR=SCREEN (Y,X):IF (SCR=AS1 OR SCR=AS2) THEN GOSUB 850:ELSE LOCATE Y,X: IF ALT THEN PRINT C2$;:ELSE PRINT B$;:Y=Y+1:IF Y>YMAX THEN Y(C)=1:X(C)=C:GOSUB 910 ELSE LOCATE Y,X:PRINT C$;:Y(C)=Y
  70. 610  NEXT
  71. 620  FOR S=1 TO 4:Y=SY(S):X=SX(S):LOCATE Y,X:PRINT SB$;:IF S>1 THEN X=X+1:SX(S)=X:IF X>SXMAX THEN X=1 :SX(S)=X
  72. 625  IF DRVY THEN GOSUB 725
  73. 630  LOCATE Y,X:PRINT S$;
  74. 640  NEXT
  75. 642  IF RVY THEN RVY=RVY-1 ELSE RVY=RND*80/(P-BONUSP+1):SRVY=RND*4+1:DRVY=RND*6+1-4
  76. 650  COLOR 1:LOCATE DY,DX:PRINT DB$;:COLOR 7:DX = DX -1
  77. 660  WEND
  78. 670  P=P+1
  79. 680  WEND
  80. 690  IF SCORE > HISCORE THEN HISCORE = SCORE
  81. 700  LOCATE 1,20:PRINT "score=";SCORE;" high score=";HISCORE;" PLAY AGAIN [y/n]";:AGAIN$=INKEY$:IF NOT (AGAIN$="y" OR AGAIN$="Y" OR AGAIN$="n" OR AGAIN$="N") THEN 700
  82. 710  WEND
  83. 720  CLS:KEY ON:END
  84. 725  IF SRVY=S THEN YT=Y+SGN(DRVY):DRVY=DRVY-SGN(DRVY):IF (YT >=SMINY AND YT=< YMAX)THEN Y=YT:SY(S)=Y
  85. 729  RETURN
  86. 730  'XPLOSION
  87. 740  COLOR 15
  88. 745  SOUND 37,3:SOUND 70,4:SOUND 150,7:SOUND 267,5:SOUND 100,3:SOUND 37,5
  89. 770  IF Y > 5 THEN MAXR = 4 ELSE MAXR=Y-2
  90. 780  IF XL=XH THEN IF SX(S)=XL-2+(S=1) THEN SCORE=SCORE+Y:FOR EX=0 TO 4:FOR XR=0 TO MAXR:LOCATE Y-MAXR+XR,XL+1+(S=1):PRINT BT$(EX,XR);:NEXT:FOR JK=1 TO EX*EX*30:NEXT:NEXT:FOR EX=8 TO 11:FOR XR=0 TO MAXR:LOCATE Y-MAXR+XR,X+1:PRINT BM$(EX,XR);:NEXT:NEXT
  91. 784  IF XL=XH THEN IF SX(S)=XL-2+(S=1) THEN FOR EX=4 TO 0 STEP -1:FOR XR=0 TO MAXR:LOCATE Y-MAXR+XR,XL+1+(S=1):PRINT BT$(EX,XR);:NEXT:FOR JK=1 TO EX*EX*50:NEXT:NEXT
  92. 788  LOCATE Y,X:PRINT"<UNK! {FEFE}><UNK! {FEFE}><UNK! {FE20}>";
  93. 790  IF X<XL THEN XL=X
  94. 800  IF X+6>XH THEN XH=X+6
  95. 810  FOR EX=0 TO 7:FOR XR=0 TO MAXR:LOCATE Y-MAXR+XR,X:PRINT BM$(EX,XR);:NEXT:NEXT
  96. 820  COLOR 7
  97. 830  LOCATE Y,X:PRINT "       ";
  98. 840  RETURN
  99. 850  'BLOWED-UP SUB
  100. 860  Y(C)=1:GOSUB 910
  101. 870  XL=X:XH=X:PS=-1
  102. 880  WHILE SCORE >PS:PS=SCORE:FOR S=1 TO 4:IF SY(S)=Y THEN IF SX(S)=<XH THEN IF SX(S)+6>XL THEN X=SX(S):GOSUB 730:SCORE=SCORE+Y:SY(S)=SMINY+RND*(YMAX-SMINY):SX(S)=1+RND*SXMAX
  103. 890  NEXT:WEND
  104. 900  RETURN
  105. 910  'FREED UP DEPTH CHG
  106. 920  FC=FC+1:IF FC= 1 THEN KEY (14) ON
  107. 930  RETURN
  108. 935  'attempt to drop one
  109. 940  N=4:WHILE Y(N)>1:N=N-1:WEND:IF N THEN Y(N)=DY+1:X(N)=DX:IF DX<1 THEN X(N)=1
  110. 960  FC=FC-1 :IF FC = 0 THEN KEY (14) OFF
  111. 970  RETURN
  112. 980  '
  113. 1000  GOSUB 1330
  114. 1010  GOSUB 1220
  115. 1020  PRINT"Do you wish to see instructions?[y/n] "
  116. 1030  A$=INKEY$:IF A$="" THEN 1030 ELSE IF (A$="n" OR A$="N") THEN RETURN
  117. 1040  LOCATE 10
  118. 1050  PRINT"INSTRUCTIONS: Object of the game is to drop depth charges from the destroyer":PRINT"at the top of the screen, and hit the submarines scattered below."
  119. 1060  PRINT
  120. 1070  PRINT"The destroyer is above the waterline and moves toward the left. When it":PRINT"passes off the left side of the screen, it reappears on the right. The '2' at":PRINT"the top right tells what pass your on. The other number, where the '35' is,"
  121. 1080  PRINT"is your current score.":PRINT:PRINT"There are 4 subs. While you move left, they move right, except one of them,":PRINT"which is always stationary."
  122. 1090  GOSUB 1290:GOSUB 1220
  123. 1100  DA$=CHR$(25)
  124. 1110  PRINT"You drop a depth charge by pressing the 'down arrow' [";DA$;"] key."
  125. 1120  PRINT"You can only drop 4 depth charges at a time. That is, if 4 of them are":PRINT"currently floating down, you have to wait for one of them to hit a sub or":PRINT"reach the bottom of the screen before you will be able to drop another - so"
  126. 1130  PRINT"it's important to plan your drops carefully.":PRINT:PRINT"Scoring - the deeper the sub, the more points you get when you hit it.":PRINT"You get double points if you get a direct hit on the conning tower [USR]."
  127. 1135  PRINT:PRINT"When a sub is hit, it will reappear at some random location. Sometimes subs"
  128. 1140  PRINT"overlap - this gives you a chance to hit two with one charge."
  129. 1150  GOSUB 1290:GOSUB 1220
  130. 1160  PRINT"You get four passes across the screen with your destroyer. On the last"
  131. 1170  PRINT"pass, a '[' will appear at the upper left to alert you. If you manage to ":PRINT"accumulate at least 200 points before the destroyer reaches the '[', the '['":PRINT"will disappear and you will get a bonus pass. You may earn additional bonus"
  132. 1180  PRINT"passes, but it gets harder and harder. Whenever you fall behind the points":PRINT"needed for an additional pass, the '[' will reappear."
  133. 1190  GOSUB 1290
  134. 1200  GOTO 1010
  135. 1210  RETURN
  136. 1220  '
  137. 1230  COLOR 7:CLS
  138. 1240  COLOR 1:PRINT SPC(79)
  139. 1250  LOCATE 1,1:PRINT"[";:LOCATE ,20 :PRINT"DEPTH CHARGE";:LOCATE ,60:PRINT D$;"   2  35":COLOR 7
  140. 1260  LOCATE 8,6:PRINT S$:LOCATE 5,42:PRINT S$:LOCATE 4,30:PRINT C2$:LOCATE 7,58:PRINT C2$
  141. 1270  LOCATE 10,1
  142. 1280  RETURN
  143. 1290  '
  144. 1300  PRINT:PRINT"              (Press any key to continue)"
  145. 1310  A$=INKEY$: IF A$ = "" THEN 1310
  146. 1320  RETURN
  147. 1330  '
  148. 1340  'title
  149. 1350  KEY OFF:CLS:COLOR 7,1,0
  150. 1360  LOCATE 6:X=36:GOSUB 1370:LOCATE 9,X+12:PRINT"RELEASE 1.2";:LOCATE 1:X=15:GOSUB 1370:GOTO 1440
  151. 1370  LOCATE ,X:PRINT"                   VARPTRSOUNDMOTORSOUNDSOUNDSOUNDSOUNDCOLOR"
  152. 1380  LOCATE ,X:PRINT"VARPTRSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTOR......CALL"
  153. 1390  LOCATE ,X:PRINT"CALLDELETE  DELETE                     MOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDCOLOR"
  154. 1400  LOCATE ,X:PRINT"CALL                                        CALL"
  155. 1410  LOCATE ,X:PRINT"CLSSOUNDCOLOR.  .  .  .  . . . . . . .......STRING$SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDUSING"
  156. 1420  LOCATE ,X:PRINT"  CLSSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMERGE"
  157. 1430  RETURN
  158. 1440  PRINT" "
  159. 1450  '
  160. 1460  PRINT"    WHILEWHILEWENDLINE    WHILEWHILEWHILEWENDWEND   WHILEWENDWENDWHILELINE   LINELINEWHILEWHILEWENDWENDWHILE  WHILE    LINE "
  161. 1470  PRINT"    WHILE   WHILE   WEND       LINE    WEND     WHILE     WEND    WHILE "
  162. 1480  PRINT"    WEND    WEND  WHILE       WHILE    WEND     WEND     WEND    WHILE "
  163. 1490  PRINT"    WHILE    WHILE  LINELINELINELINEWHILE   WHILEWHILELINELINEWHILE      WEND     WHILEWHILELINELINEWHILEWEND "
  164. 1500  PRINT"    LINE    LINE  LINE       WEND          WHILE     LINE    WEND "
  165. 1510  PRINT"    LINE   LINE   LINE       WEND          LINE     LINE    WHILE "
  166. 1520  PRINT"    WHILEWHILEWENDLINE    WHILEWHILEWHILEWENDWEND   WHILE          LINE     WHILE    LINE "
  167. 1530  PRINT" "
  168. 1540  PRINT"                  WHILEWHILEWENDLINE    WHILE    WEND    WENDWENDWHILELINE   LINELINEWHILEWHILEWENDWEND    WHILEWHILELINELINE    LINELINEWHILEWENDWEND "
  169. 1550  PRINT"                 WHILEWHILE   WHILE   WEND    WEND   LINE    WEND  WHILE     WEND  WHILELINE   WHILE   WHILE     "
  170. 1560  PRINT"   Jerry Kotler  WEND        WHILE    WHILE   WHILE    WEND  WEND     WEND  WHILE        WEND     "
  171. 1570  PRINT"   I S Services  WHILE        LINELINELINEWHILELINEWHILE   WHILEWHILELINELINEWHILEWHILE  WENDWHILELINELINEWHILEWEND   WEND   WHILEWENDWHILE  WHILELINEWHILEWEND  "
  172. 1580  PRINT"   Los  Angeles  LINE        LINE    LINE   WEND    LINE  WHILE   LINE    WEND    WEND   WHILE     "
  173. 1590  PRINT"                 LINELINE   LINE   LINE    LINE   WEND    LINE  LINE    LINE   WHILEWHILE   WHILE   LINE     "
  174. 1600  PRINT"                  WHILEWHILEWENDLINE    WHILE    WHILE   WHILE    WHILE  LINE     WHILE   LINELINEWHILEWEND    LINEWHILEWENDWHILELINE "
  175. 1610  COLOR 7
  176. 1620  DEF SEG
  177. 1630  B=0:V=0:SA%=0:N=0
  178. 1640  DATA 30, 184,0, 176, 142, 216, 176, 24, 187, 1,0, 185, 79,0, 138, 39, 138, 87, 2, 136, 23, 67, 67, 226, 247, 136, 39, 67, 67, 254, 200, 117, 234, 31, 203
  179. 1650  L=35
  180. 1660  DIM S%(L/2+1)
  181. 1670  SA%=VARPTR (S%(0))
  182. 1680  FOR B=SA% TO SA%+L-1:READ V:POKE B,V:NEXT
  183. 1690  'set highlights
  184. 1700  BUF=&HB000
  185. 1710  ATP$="11111111111100222001111111002200111110001110000111110000111000011111111000222000" '1=hilite,0=normal,2=invisible
  186. 1720  AT%(0)=7:AT%(1)=15:AT%(2)=0
  187. 1730  A=1:YE=23*160:DEF SEG=BUF
  188. 1740  FOR N=1 TO 80:N0=AT%(VAL(MID$(ATP$,N,1))):FOR Y=A TO YE STEP 160:POKE Y,N0:NEXT:A=A+2:NEXT
  189. 1750  DEF SEG:SY=0:SA%=VARPTR(S%(0)):SY=SA%+7
  190. 1760  FOR Y=3 TO 1 STEP -1 :POKE SY,Y:FOR N=1 TO 79:CALL SA%:NEXT:NEXT:POKE SY,24
  191. 1770  FOR Y=1 TO 24:POKE SY,Y:FOR N=1 TO INT(Y/6):CALL SA%:NEXT:NEXT
  192. 1780  COLOR 0:PRINT SPC(30);"Press any key to start";:LOCATE ,60:COLOR 7:PRINT SPC(19);
  193. 1790  DEF SEG
  194. 1800  N1=30:N2=1000:S1=5:W1=0:W2=10000:W=0
  195. 1810  A$="":SA%=VARPTR(S%(0))
  196. 1820  WHILE A$=""
  197. 1830  S1=RND*3+2
  198. 1840  FOR N=N1 TO N2 STEP S1:CALL SA%:FOR W=W1 TO W2 STEP N:NEXT:A$=INKEY$:IF A$ <>"" THEN N=N2
  199. 1850  NEXT
  200. 1860  IF A$<>"" THEN 1890
  201. 1870  FOR N=N2 TO N1 STEP -S1:CALL SA%:FOR W=W1 TO W2 STEP N:NEXT:A$=INKEY$:IF A$<>"" THEN N=N1
  202. 1880  NEXT
  203. 1890  WEND
  204. 1900  WHILE A$<>"":A$=INKEY$:WEND 'flush buffer
  205. 1910  RETURN
  206.